perm filename VIEWER[GEM,BGB]1 blob
sn#032383 filedate 1973-04-01 generic text, type T, neo UTF8
00100 TITLE VIEWER - IMAGE FORMING SUBROUTINES - JULY 1972.
00200
00300 EXTERN OTHER,VCW,VCCW,ECCW
00400 EXTERN KLJUTS,KLJOTS,KLTMPS
00500 EXTERN IIIDPY
00600
00700 ;VARIABLES GLOBAL TO VIEWER SUBROUTINES.
00800 DECLARE{XL,XH,YL,YH}
00900 DECLARE{FOCAL,LDZ}
01000 DECLARE{SCALEX,SCALEY,SCALEZ}
01100 DECLARE{SOX,SOY,MAG}
01200 DECLARE{CAMFRAME}
01300
01400 DECLARE{ZCCMIN}
01500 DECLARE{FOLDCNT,EDGECNT}
01600
01700 DECLARE{CAMERA,WINDOW,WORLD,GLASS}
00100 SUBR(SHOW1)WINDOW,GLASS -----------------------------------------
00200 BEGIN SHOW1; SHOW THRU WINDOW, TYPE 1 - DISPLAY ALL EDGES IN VIEW.
00250 LACM ARG1↔ANDI 17↔DAC GLASS
00300 LAC 1,ARG2↔DAC 1,WINDOW
00400 ALT2 2,1↔DAC 2,WORLD↔JUMPE 2,POP2J.
00500 $TYPE 0,2↔CAIE 0,$WORLD↔GO .+4
00600 ALT 0,1↔DAC CAMERA↔JUMPE POP2J.
00700 CALL(PPROJ,CAMERA,WORLD)
00800 CALL(EMRKALL,WORLD)
00810 CALL(CLIPER,WINDOW)
00850 CALL(IIIDPY,WINDOW,GLASS)
00900 POP2J
01000 BEND SHOW1; BGB 16 MARCH 1973 ------------------------------------
01100
01200 SUBR(SHOW3)WINDOW,GLASS -----------------------------------------
01300 BEGIN SHOW3; SHOW THUR WINDOW, TYPE 3 - BACKSIDED FACES REMOVED.
01350 LACM ARG1↔ANDI 17↔DAC GLASS
01400 LAC 1,ARG2↔DAC 1,WINDOW
01500 ALT 0,1↔DAC CAMERA↔JUMPE POP2J.
01600 ALT2 0,1↔DAC WORLD↔JUMPE POP2J.
01700 CALL(PPROJ,CAMERA,WORLD)
01800 CALL(FMRK,WORLD)
01900 CALL(EMRK,WORLD)
01901 CALL(CLIPER,WINDOW)
01910 CALL(IIIDPY,WINDOW,GLASS)
02000 POP2J
02100 BEND SHOW3; BGB 16 MARCH 1973 ------------------------------------
02200
00100 SUBR(SHOW2)WINDOW,GLASS ------------------------------------------
00200 BEGIN SHOW2; SHOW WINDOW TYPE 2 - VECTOR HIDDEN LINE IMAGE.
00300 EXTERN OCCULT
00400 LACM ARG1↔ANDI 17↔DAC GLASS
00500 LAC 1,ARG2↔DAC 1,WINDOW
00600 ALT 0,1↔DAC CAMERA↔JUMPE POP2J.
00700 ALT2 0,1↔DAC WORLD↔JUMPE POP2J.
00800 CALL(PPROJ,CAMERA,WORLD)
00900 CALL(FMRK,WORLD)
01000 CALL(EMRK,WORLD)
01100 CALL(OCCULT,WORLD)
01200 CALL(KLJOTS,WORLD)
01300 CALL(CLIPER,WINDOW)
01400 CALL(IIIDPY,WINDOW,GLASS)
01500 CALL(KLTMPS,WORLD)
01600 POP2J
01700 BEND SHOW2; 16 MARCH 1973 ----------------------------------------
01800
01900 SUBR(SHOW4)WINDOW,GLASS ------------------------------------------
02000 BEGIN SHOW3; SHOW WINDOW TYPE 3B - RUN OCCULT DIAGONOSTICS.
02100 EXTERN OCCULT
02200 LACM ARG1↔ANDI 17↔DAC GLASS
02300 LAC 1,ARG2↔DAC 1,WINDOW
02400 ALT 0,1↔DAC CAMERA↔JUMPE POP2J.
02500 ALT2 0,1↔DAC WORLD↔JUMPE POP2J.
02600 CALL(PPROJ,CAMERA,WORLD)
02700 CALL(FMRK,WORLD)
02800 CALL(EMRK,WORLD)
02900 CALL({OCCULT+1},WORLD)
03000 CALL(KLJOTS,WORLD)
03100 CALL(CLIPER,WINDOW)
03200 CALL(IIIDPY,WINDOW,GLASS)
03300 CALL(KLTMPS,WORLD)
03400 POP2J
03500 BEND;2/12/73------------------------------------------------------
00100 SUBR(CROP)WINDOW -------------------------------------------------
00200 BEGIN CROP
00300 ; XL ← (OX - MAG*LDX) MAX -511.
00400 ; XH ← (OX + MAG*LDX) MIN +511.
00500 ; YL ← (OY - MAG*LDY) MAX -384.
00600 ; YH ← (OY + MAG*LDY) MIN +384.
00700 ACCUMULATORS{WND,C,OX,OY,LDX,LDY,MAG}
00800 LAC WND,ARG1
00900 ALT C,WND↔JUMPE C,POP1J.
01000 LAC MAG,-1(WND)
01100 NIP OX,-2(WND)↔FLOAT OX,
01200 NAP OY,-2(WND)↔FLOAT OY,
01300 NAP LDX,1(C)↔FLOAT LDX,
01400 NAP LDY,2(C)↔FLOAT LDY,
01500
01600 LAC LDX↔FMPR MAG↔DAC OX,1
01700 FSBR 1,0↔FADR 0,OX↔FIXX 0,↔FIXX 1,
01800 CAMGE 1,[-=511]↔LAC 1,[-=511]↔DIP 1,1(WND)
01900 CAMLE 0,[ =511]↔LAC 0,[ =511]↔DAP 0,1(WND)
02000
02100 LAC LDY↔FMPR MAG↔DAC OY,1
02200 FSBR 1,0↔FADR 0,OY↔FIXX 0,↔FIXX 1,
02300 CAMGE 1,[-=384]↔LAC 1,[-=384]↔DIP 1,2(WND)
02400 CAMLE 0,[ =384]↔LAC 0,[ =384]↔DAP 0,2(WND)
02500
02600 POP1J
02700 BEND CROP; 13 MARCH 1973 -----------------------------------------
00100 SUBR(PPROJ)CAMERA,WORLD---------------------------------------
00200 BEGIN PPROJ
00300 ACCUMULATORS{B,F,E,V,CAM,E0,X,XX,Y,YY,Z,ZZ}
00400 LAC B,ARG1↔$TYPE 0,B↔CAIE $WORLD↔POP2J
00500 ;CLEAR FACE PZZ & NZZ BITS.
00600 LAC B,ARG1
00700 I0: CCW B,B↔TESTZ B,BBIT↔GO[LAC F,B
00800 I1: PFACE F,F↔TEST F,FBIT↔GO I0↔MARKZ F,PZZ∨NZZ↔GO I1]
00900
01000 ;GET CAMERA SCALES AND FOCAL.
01100 LAC CAM,ARG2
01200 LAC -3(CAM)↔DAC SCALEX
01300 LAC -2(CAM)↔DAC SCALEY
01400 LAC -1(CAM)↔DAC SCALEZ
01500 HLLZ 3(CAM)↔DAC FOCAL
01600 CDR 3(CAM)↔FLOAT↔DAC LDZ
01700
01800 ;GET THE CAMERA'S FRAME.
01900 LAC CAM,ARG2
02000 FRAME CAM,CAM
02100 DAC CAM,CAMFRAME
02200
02300 ;FOR ALL THE BODIES OF THE WORLD.
02400 LAC B,ARG1
02500 L1: CCW B,B
02600 TEST B,BBIT↔POP2J
02700 MARKZ B,VISIBLE
02800
02900 ;FOR ALL THE VERTICES OF EACH BODY.
03000 LAC V,B
03100 L2: PVT V,V
03200 TEST V,VBIT↔GO L1
03300 ZIP 7(V); CLEAR POTENT VALENCE.
00100 ;TRANSLATE TO CAMERA LOCUS.
00200
00300 LAC X,XWC(V)↔FSBR X,XWC(CAM)
00400 LAC Y,YWC(V)↔FSBR Y,YWC(CAM)
00500 LAC Z,ZWC(V)↔FSBR Z,ZWC(CAM)
00600
00700 ;ROTATE TO CAMERA ORIENTATION.
00800
00900 DEFINE ROTATE $(QQ,Q){
01000 LAC QQ,X↔ FMPR QQ,Q$X(CAM)
01100 LAC Y↔FMPR Q$Y(CAM)↔FADR QQ,
01200 LAC Z↔FMPR Q$Z(CAM)↔FADR QQ,}
01300 ROTATE(XX,I);
01400 ROTATE(YY,J);
01500 ROTATE(ZZ,K);
01600
01700 ;PERSPECTIVE TRANSFORMATION.
01800
01900 FMPR XX,SCALEX↔FDVR XX,ZZ↔DAC XX,XPP(V)
02000 FMPR YY,SCALEY↔FDVR YY,ZZ↔DAC YY,YPP(V)
02100 MOVN Z,SCALEZ↔FDVR Z,ZZ↔DAC Z,ZPP(V)
00100 ;PPROJ(CAMERA,WORLD) CONTINUED.
00200 ;DO Z-CLIP MARKING WRT CAMERA CENTERED COORDINATES.
00300 SLACI X,(JUTBIT+JOTBIT+PZZ+NZZ+FOLDED+VISIBLE+POTENT)
00350 ANDCAM X,(V) ;TURN 'EM ALL OFF.
00400 SLACI X,(PZZ) ; + HALFSPACE, BEHIND THE CAMERA.
00500 MOVN FOCAL
00600 CAMGE ZZ,0 ;SKIP WHEN Zcc ≥ -FOCAL.
00700 SLACI X,(NZZ) ; - HALFSPACE, INVIEW.
00800 IORM X,(V)
00900 PED E,V↔DAC E,E0↔JUMPE E,[
01000 PFACE F,B↔IORM X,(F)↔GO L1] ;VERTEX BODY CASE.
01100
01200 L3: PVT 1,E↔CAME 1,V↔GO .+3↔PCW 1,E↔GO .+5
01300 NVT 1,E↔CAME 1,V↔GO L2 ↔NCW 1,E
01400 IORM X,(E)
01500 PFACE F,E↔IORM X,(F)
01600 NFACE F,E↔IORM X,(F)
01700 LAC E,1↔CAME E,E0↔GO L3↔GO L2
01800 BEND;1/14/73------------------------------------------------------
00100 SUBR(EMRKALL)WORLD-----------------------------------------------
00200 BEGIN EMRKALL;MARK ALL EDGE AS POTENT.
00300 ACCUMULATORS{B,E}
00400 ;FOR ALL THE BODIES OF THE WORLD.
00500 LAC B,ARG1
00600 L1: CCW B,B
00700 TEST B,BBIT↔POP1J
00800 ;FOR ALL THE EDGES OF EACH BODY.
00900 LAC E,B
01000 L2: PED E,E
01100 TEST E,EBIT↔GO L1
01200 MARK E,POTENT↔GO L2
01300 BEND;1/14/73------------------------------------------------------
00100 SUBR(UNPROJECT)VERTEX---------------------------------------------
00200 BEGIN UNPROJ
00300 ACCUMULATORS{V,C,X,Y,Z,XX,YY,ZZ}
00400 LAC V,ARG1
00500 LAC C,CAMFRAME
00600
00700 ;UNDO PERSPECTIVE.
00800 LACN Z,SCALEZ↔FDVR Z,ZPP(V)
00900 LAC Y,YPP(V)↔FMPR Y,Z↔FDVR Y,SCALEY
01000 LAC X,XPP(V)↔FMPR X,Z↔FDVR X,SCALEX
01100
01200 ;ROTATE BY TRANSPOSE OF CAMERA ORIENTATION.
01300 LAC XX,X↔FMPR XX,IX(C)
01400 LAC Y↔FMPR JX(C)↔FADR XX,
01500 LAC Z↔FMPR KX(C)↔FADR XX,
01600
01700 LAC YY,Y↔FMPR YY,IY(C)
01800 LAC Y↔FMPR JY(C)↔FADR YY,
01900 LAC Z↔FMPR KY(C)↔FADR YY,
02000
02100 LAC ZZ,Z↔FMPR ZZ,IZ(C)
02200 LAC Y↔FMPR JZ(C)↔FADR ZZ,
02300 LAC Z↔FMPR KZ(C)↔FADR ZZ,
02400
02500 ;TRANSLATE TO CAMERA LOCUS.
02600 FADR XX,XWC(C)↔DAC XX,XWC(V)
02700 FADR YY,YWC(C)↔DAC YY,YWC(V)
02800 FADR ZZ,ZWC(C)↔DAC ZZ,ZWC(V)
02900 POP1J
03000 BEND;1/14/73------------------------------------------------------
00100 SUBR(FACOEF)BODY OR FACE,FLAG-------------------------------------
00200 BEGIN FACOEF;FACE COEFFICIENTS - FLAG=0 FOR WC, FLAG=-1 FOR PP.
00300
00400 ACCUMULATORS {Q,E,V1,V2,V3,ABC,F,ARG}
00500 FOR @% Qε{XYZ}{FOR @$ N←1,3{
00600 DEFINE Q%$N<Q%WC(V$N)>↔}}
00700 ;FOREACH F|BF⊗B≡F.
00800 LAC F,ARG2
00900 LAC ARG,(F) ;ORIGINAL ARG TYPE.
01000 TLNN ARG,(BBIT)↔GO L2
01100 L1: PFACE F,F
01200 TEST F,FBIT↔POP2J
01300 ;FIRST THREE VERTICES CCW ABOUT THE FACE.
01400 L2: PED E,F↔ZIP 6(F) ;CLEAR ALT LINK.
01500 SETQ(V1,{VCW,E,F})
01600 SETQ(V2,{VCCW,E,F})
01700 SETQ(E,{ECCW,E,F})
01800 SETQ(V3,{VCCW,E,F})
01900 ;FLG TRUE FOR PERSPECTIVE PROJECTED FACOEF.
02000 SKIPE ARG1
02100 GO[ADDI V1,7↔ADDI V2,7↔ADDI V3,7↔GO .+1]
02200 ;KK(F) ← X1*(Z2*Y3-Y2*Z3) + Y1*(X2*Z3-Z2*X3) + Z1*(Y2*X3-X2*Y3).
02300 LAC 1,Z2↔FMPR 1,Y3↔LAC Y2↔FMPR Z3↔FSBR 1,0↔FMPR 1,X1
02400 LAC 2,X2↔FMPR 2,Z3
02500 LAC Z2↔FMPR X3↔FSBR 2,0↔FMPR 2,Y1↔FADR 1,2
02600 LAC 3,Y2↔FMPR 3,X3
02700 LAC X2↔FMPR Y3↔FSBR 3,0↔FMPR 3,Z1↔FADR 1,3
02800 DAC 1,KK(F)
02900 ;AA(F) ← (Z1*(Y2-Y3) + Z2*(Y3-Y1) + Z3*(Y1-Y2)).
03000 LAC 1,Y2↔FSBR 1,Y3↔FMPR 1,Z1↔LAC 0,1
03100 LAC 1,Y3↔FSBR 1,Y1↔FMPR 1,Z2↔FADR 0,1
03200 LAC 1,Y1↔FSBR 1,Y2↔FMPR 1,Z3↔FADR 0,1
03300 DAC AA(F)↔FMPR↔DAC ABC
03400 ;BB(F) ← (X1*(Z2-Z3) + X2*(Z3-Z1) + X3*(Z1-Z2)).
03500 LAC 1,Z2↔FSBR 1,Z3↔FMPR 1,X1↔LAC 0,1
03600 LAC 1,Z3↔FSBR 1,Z1↔FMPR 1,X2↔FADR 0,1
03700 LAC 1,Z1↔FSBR 1,Z2↔FMPR 1,X3↔FADR 0,1
03800 DAC BB(F)↔FMPR↔FADRM ABC
03900 ;CC(F) ← (X1*(Y3-Y2) + X2*(Y1-Y3) + X3*(Y2-Y1)).
04000 LAC 1,Y3↔FSBR 1,Y2↔FMPR 1,X1↔LAC 0,1
04100 LAC 1,Y1↔FSBR 1,Y3↔FMPR 1,X2↔FADR 0,1
04200 LAC 1,Y2↔FSBR 1,Y1↔FMPR 1,X3↔FADR 0,1
04300 DAC CC(F)↔FMPR↔FADRM ABC
04400 ;NORMALIZE.
04500 EXTERN SQRT↔CALL(SQRT,ABC)↔SLACI(<1.0>)↔FDVR 1
04600 FMPRM AA(F)↔FMPRM BB(F)↔FMPRM CC(F)↔FMPRM KK(F)
04700 TLNN ARG,(BBIT)↔POP2J↔GO L1
04800 BEND;1/14/73------------------------------------------------------
00100 SUBR(ENORM)BODY---------------------------------------------------
00200 BEGIN ENORM;COMPUTE EDGE NORMALS FROM FACE NORMALS.
00300 ACCUMULATORS{E,F1,F2}
00400 LAC E,ARG1
00500 PED E,E↔TEST E,EBIT↔POP1J
00600 PFACE F1,E↔NFACE F2,E
00700 LAC AA(F1)↔FAD AA(F2)↔FSC -1↔DACN AA(E)
00800 LAC BB(F1)↔FAD BB(F2)↔FSC -1↔DACN BB(E)
00900 LAC CC(F1)↔FAD CC(F2)↔FSC -1↔DACN CC(E)
01000 GO ENORM+1
01100 BEND;1/14/73------------------------------------------------------
01200
01300 SUBR(VNORM)BODY---------------------------------------------------
01400 BEGIN VNORM;COMPUTE VERTEX NORMALS FROM EDGE NROMALS.
01500 ACCUMULATORS{V,E,E0,A,B,C}
01600 LAC V,ARG1
01700 L1: PVT V,V↔TEST V,VBIT↔POP1J
01800 PED E,V↔SKIPN E0,E↔POP1J ;VERTEX BODY CASE.
01900 SETZB 0,A↔SETZB B,C
02000 L2: FAD A,AA(E)↔FAD B,BB(E)↔FAD C,CC(E)
02100 PVT 1,E↔CAME 1,V↔GO .+3↔PCW E,E↔GO .+5
02200 NVT 1,E↔CAME 1,V↔AOJA .+5↔NCW E,E
02300 CAME E,E0↔AOJA L2↔AOS
02400 FSC 233↔FDV A,↔FDV B,↔FDV C,
02500 DAC A,XPP(V)↔DAC B,YPP(V)↔DAC C,ZPP(V)
02600 GO L1
02700 BEND;1/14/73------------------------------------------------------
00100 SUBR(ZCLIPF)FACE--------------------------------------------------
00200 BEGIN ZCLIPF
00300 GO L0
00400 DECLARE{F,E,V,V1,V2,U0,U1,U2,ENEW,F0}
00500 EXTERN MKFE,ESPLIT
00600 ;GET A PZZ VERTEX OF F0
00700 L0: LAC 1,ARG1
00800 DAC 1,F0↔DAC 1,U1↔DAC 1,F
00900 PED 0,1↔DAC E
01000
01100 L1: SETQ(E,{ECCW,E,F})
01200 SETQ(V,{VCCW,E,F})
01300 TEST 1,PZZ↔GO L1
01400
01500 ;GET FIRST NZZ VERTEX CCW AROUND F FROM E.
01600 L2: SETQ(E,{ECCW,E,F})
01700 SETQ(V,{VCCW,E,F})
01800 TEST 1,NZZ↔GO L2
01900
02000 ;MAKE Z-CLIP VERTEX.
02100 LAC 1,E↔PVT 0,1↔CAMN 0,V↔GO .+3↔CALL INVERT,E
02200 PVT 0,1↔DAC V1
02300 NVT 0,1↔DAC V2
02400 SETQ(U2,{ESPLIT,E})
02500 LAC 1,U2↔MARK 1,TMPBIT
02550 LAC 1,E↔TEST 1,DARKEN↔GO[
02575 LAC 1,U2↔MARK 1,DARKEN↔GO .+1]
02600 CALL ZCLIP,V1,U2,V2
02700 CALL UNPROJECT,U2
02800 LAC 1,U2↔MARK 1,NZZ
02900
03000 ;MAKE Z-CLIP EDGE.
03100 L3: LAC 1,U1↔TEST 1,VBIT↔GO L4
03200 SETQ(ENEW,{MKFE,U1,F,U2})
03300 LAC 2,ENEW↔NFACE 1,2
03400 MARK 1,PZZ
03500 MARK 2,TMPBIT
03600 LAC 1,F↔MARKZ 1,PZZ
03700 MARK 1,NZZ
03800 CAMN 1,F0↔POP1J; .......EXIT.
03900 NFACE 1,2↔DAC 1,F
04000 MARK 1,PZZ
04100 GO .+3
04200 L4: LAC U2↔DAC U0
04300
04400 ;ADVANCE INTO THE NEXT FACE.
04500 LAC U2↔DAC U1
04600 SETQ(F,{OTHER,E,F})
04700 CAME 1,F0↔GO L2
04800 LAC U0↔DAC U2↔GO L3
04900 BEND;1/14/73------------------------------------------------------
00100 SUBR(FMRK)WORLD--------------------------------------------------
00200 BEGIN FMRK; MARK POTENT FACES.
00300 ACCUMULATORS{W,B,F,Q,R}
00400
00500 ;INITIALIZE THE WORLD'S POTENTIALLY VISIBLE FACE AND EDGE LISTS.
00600 LAC 1,ARG1↔SETZ
00700 PFACE. 0,1↔PED. 0,1↔NED. 0,1
00800
00900 ;FOR ALL THE BODIES OF THE WORLD.
01000 LAC B,ARG1↔DAC B,BODY#
01100 L1: LAC B,BODY↔CCW B,B↔DAC B,BODY
01200 TEST B,BBIT↔POP1J
01300
01400 ;FOR ALL THE FACES OF EACH BODY.
01500 LAC F,B
01600 L2: PFACE F,F↔DAC F,FACE#
01700 TEST F,FBIT↔GO L1
01800 HIDE F
01900 TEST F,NZZ↔GO L2 ;FACE IS FULLY BEHIND THE CAMERA.
02000 TEST F,PZZ↔GO L3 ;FACE IS PARTIALLY IN VIEW.
02100 CALL ZCLIPF,F ;DO Z-CLIPPING.
02200 LAC F,FACE
02300 L3: SETOM↔CALL(FACOEF,F,0)
02400 LAC F,FACE
02500 LAC CC(F)↔FMPR LDZ
02600 CAML KK(F)↔GO L2 ;FACE HAS BACKSIDE TOWARDS CAMERA.
02700
02800 ;POTENTIALLY VISIBLE FACE.
02900 L4: MARK F,POTENT
03000 LAC 1,ARG1↔PFACE 0,1
03100 POTEN. 0,F↔PFACE. F,1
03200 GO L2
03300 BEND;1/14/73------------------------------------------------------
00100 SUBR(EMRK)WORLD--------------------------------------------------
00200 BEGIN EMRK; MARK POTENT EDGES FOR OCCULT.
00300 ACCUMULATORS{Q,R,S,B,F1,F2,E,A,FLG}
00400 ACCUMULATORS{V1,V2}
00500 EXTERN INVERT,SQRT
00600 SETZM FOLDCNT↔SETZM EDGECNT
00700 ;FOR ALL THE BODIES OF THE WORLD.
00800 LAC B,ARG1
00900 L1: CCW B,B↔TEST B,BBIT↔POP1J
01000 ;FOR ALL THE EDGES OF EACH BODY.
01100 LAC E,B
01200 L2: PED E,E↔TEST E,EBIT↔GO L1
01250 DZM↔POTEN. 0,(E)
01300 MARKZ E,7B13
01400 PFACE F1,E
01500 NFACE F2,E
01600
01700 ;WHEN EITHER FACE IS POTENT THEN THE EDGE IS POTENT.
01800 LAC(F1)↔IOR(F2)↔TLNN(POTENT)↔GO L2
01900 MARK E,POTENT
02000 ;CONS THE EGDE INTO THE WORLD'S POTENTIALLY VISIBLE EDGE LIST.
02100 LAC 1,ARG1↔PED 0,1↔SKIPN↔NED. E,1
02200 PED. E,1↔POTEN. 0,E↔ZIP 7(E)
02300 AOSA FLG,EDGECNT
02400
02500 ;COMPUTE NORMALIZED EDGE COEFFICIENTS.
02600 SUBR(ECOEF)
02700 GO[SETZ FLG,↔LAC E,ARG1↔GO .+1]
02800 NVT V1,E↔PVT V2,E
02900 LAC YPP(V2)↔FSBR YPP(V1)↔DAC AA(E)↔FMPR↔DAC 1
03000 LAC XPP(V1)↔FSBR XPP(V2)↔DAC BB(E)↔FMPR↔FADR 1,0
03100 LAC XPP(V2)↔FMPR YPP(V1)
03200 LAC S,XPP(V1)↔FMPR S,YPP(V2)
03300 FSBR S↔DAC CC(E)
03400 CALL(SQRT,1)
03500 SLACI(<1.0>)↔FDVR 0,1
03600 FMPRM AA(E)↔FMPRM BB(E)↔FMPRM CC(E)
03700 JUMPE FLG,POP1J.
03800 MARK V1,POTENT↔IORM(V2)
03900 CAR 7(V1)↔AOS↔DIP 7(V1) ;VALENCE.
04000 CAR 7(V2)↔AOS↔DIP 7(V2) ;VALENCE.
04100
04200 ;WHEN ONLY ONE FACE IS POTENT THEN EDGE IS FOLDED.
04300 LAC(F1)↔XOR(F2)↔TLNN(POTENT)↔GO L2
04400 TEST F1,POTENT↔GO[CALL INVERT,E↔GO .+1];NOTA BENE !
04500 MARK E,FOLDED↔IORM(V1)↔IORM(V2)
04600 GO L2
04700 BEND;1/14/73------------------------------------------------------
00100 ;VMARK(WINDOW,WORLD) - MARK THE NSEW BIT OF ALL THE VERTICES.
00200 VMARK: 0
00300 BEGIN VMARK;BGB - 4 FEB 1973.
00400 ACCUMULATORS{B,E,V,X,Y}
00500
00600 ;GET THE 2D CLIP WINDOW FRAME.
00700 LAC 1,ARG1
00800 NIP 1(1)↔FLOAT↔DAC XL
00900 NAP 1(1)↔FLOAT↔DAC XH
01000 NIP 2(1)↔FLOAT↔DAC YL
01100 NAP 2(1)↔FLOAT↔DAC YH
01200
01300 ;SOURCE-OBJECT MAPPING.
01400 LAC -1(1)↔DAC MAG
01500 NIP 2,-3(1)↔FLOAT 2,↔FMPR 2,MAG
01600 NIP 0,-2(1)↔FLOAT↔FSB 2↔DAC SOX
01700 NAP 2,-3(1)↔FLOAT 2,↔FMPR 2,MAG
01800 NAP 0,-2(1)↔FLOAT↔FSB 2↔DAC SOY
01900
02000 ;FOR ALL THE BODIES OF THE WORLD.
02100 LAC B,ARG1↔ALT2 B,B
02200 L1: CCW B,B
02300 TEST B,BBIT↔GO @VMARK
02400
02500 ;FOR ALL THE VERTICES OF EACH BODY.
02600 LAC V,B
02700 L2: PVT V,V
02800 TEST V,VBIT↔GO L1
02900 TESTZ V,POTENT↔ZAP 7(V)
03000
03100 ;COMPUTE DISPLAY COORDINATES OF THE VERTEX.
03200 LAC X,XPP(V)↔FMPR X,MAG↔FADR X,SOX↔XDC. X,V↔HLLES X
03300 LAC Y,YPP(V)↔FMPR Y,MAG↔FADR Y,SOY↔YDC. Y,V↔HLLES Y
03400
03500 ;DO XY-CLIP MARKING.
03600 TYPE 0,V↔TRZ(NSEW);NSEW RESET.
03700 CAMLE Y,YH↔TRO(NORTH)
03800 CAMGE Y,YL↔TRO(SOUTH)
03900 CAMLE X,XH↔TRO(EAST)
04000 CAMGE X,XL↔TRO(WEST)
04100 TYPE. 0,V
04200 GO L2
04300 BEND;1/14/73------------------------------------------------------
00100 SUBR(ZCLIP)V1,U,V2------------------------------------------------
00200 BEGIN ZCLIP
00300 F←0 ↔ U←1
00400 ACCUMULATORS{V1,V2,X1,Y1,Z1,X2,Y2,Z2}
00500 SAVAC(11)
00600
00700 ;V1 BEHIND CAMERA PLANE, V2 VEFORE CAMERA PLANE.
00800 CDR V1,ARG3
00900 CDR U,ARG2
01000 CDR V2,ARG1
01100 LAC F,FOCAL
01200
01300 ;UNPROJECT TO CAMERA CENTERED COORDINATES.
01400 FOR @$ I←1,2{
01500 MOVN Z$I,SCALEZ↔ FDVR Z$I,ZPP(V$I)
01600 LAC Y$I,Z$I↔ FMPR Y$I,YPP(V$I)↔ FDVR Y$I,SCALEY
01700 LAC X$I,Z$I↔ FMPR X$I,XPP(V$I)↔ FDVR X$I,SCALEX}
01800
01900 ;PIERCE Z=-FOCAL PLANE BY SIMILAR TRIANGLES & REPROJECT.
02000 FSBR X1,X2↔ FSBR Y1,Y2↔ FSBR Z1,Z2
02100 FADR Z2,F↔MOVNS Z2
02200
02300 FMPR X1,Z2↔FDVR X1,Z1↔FADR X1,X2
02400 FMPR X1,SCALEX↔FDVR X1,F↔DACN X1,XPP(U)
02500
02600 FMPR Y1,Z2↔FDVR Y1,Z1↔FADR Y1,Y2
02700 FMPR Y1,SCALEY↔FDVR Y1,F↔DACN Y1,YPP(U)
02800 LAC 2,SCALEZ↔FDVR 2,F↔DAC 2,ZPP(U)
02900
03000 ;MARK U'S NSEW BITS.
03100 ACCUMULATORS{XX,YY}
03200 LAC XX,XPP(U)↔FMPR XX,MAG↔FADR XX,SOX↔XDC. XX,U↔HLLES
03300 LAC YY,YPP(U)↔FMPR YY,MAG↔FADR YY,SOY↔YDC. YY,U↔HLLES
03400 TYPE 0,U↔TRZ(NSEW);NSEW RESET.
03500 CAMLE YY,YH↔TRO(NORTH)
03600 CAMGE YY,YL↔TRO(SOUTH)
03700 CAMLE XX,XH↔TRO(EAST)
03800 CAMGE XX,XL↔TRO(WEST)
03900 TRZ(PZZ)↔TRO(NZZ)
04000 TYPE. 0,U
04100
04200 GETAC(11)
04300 POP3J
04400 BEND;1/14/73------------------------------------------------------
00100 ;XY-CLIPPER, SKIPS WHEN PORTION IS VISIBLE.
00200 ;EXPECTS ACCUMULATORS TO BE INITIALIZED.
00300 BEGIN XYCLIP
00400 ACCUMULATORS{E,V1,V2,X1,Y1,X2,Y2,PTR}
00500 DECLARE{A,B,C,FLGO,FLGZ,AXH,AXL,BYH,BYL,QNE,QNW,QSW,QSE}
00600
00700 ↑XYCLIP: 0
00800 ;GET NSEW BITS.
00900 LDB 0,[POINT 4,(V1),8];
01000 LDB 1,[POINT 4,(V2),8];
01100 ;EASY OUTSIDER EDGE.
01200 TRNE 0,(1)↔GO @XYCLIP
01300 ;GET ENDS' LOCII.
01400 XDC X1,V1↔YDC Y1,V1
01500 XDC X2,V2↔YDC Y2,V2
01600
01700 ;EASY INSIDER VERTICES.
01800 JUMPE 0,[LAC X1↔FIXX↔DIP(PTR)↔
01900 LAC Y1↔FIXX↔DAP(PTR)↔AOBJN PTR,.+1]
02000 JUMPE 1,[LAC X2↔FIXX↔DIP(PTR)↔
02100 LAC Y2↔FIXX↔DAP(PTR)↔AOBJN PTR,.+1↔GO L]
02200
02300 ;COMPUTE EDGE COEFFICIENTS.
02400 LAC Y1↔FSBR Y2↔DAC A
02500 LAC X2↔FSBR X1↔DAC B
02600 LAC X2↔FMPR Y1↔MOVNM C
02700 LAC X1↔FMPR Y2↔FADRM C
02800
02900 ;PARTIAL PRODUCTS.
03000 LAC A↔FMPR XH↔DAC AXH
03100 LAC A↔FMPR XL↔DAC AXL
03200 LAC B↔FMPR YH↔DAC BYH
03300 LAC B↔FMPR YL↔DAC BYL
03400
03500 ;CORNER Q'S.
03600 SETOM FLGO↔SETZM FLGZ
03700 LAC AXH↔FADR BYH↔FADR C↔DAC QNE↔ANDM FLGO↔IORM FLGZ
03800 LAC AXL↔FADR BYH↔FADR C↔DAC QNW↔ANDM FLGO↔IORM FLGZ
03900 LAC AXL↔FADR BYL↔FADR C↔DAC QSW↔ANDM FLGO↔IORM FLGZ
04000 LAC AXH↔FADR BYL↔FADR C↔DAC QSE↔ANDM FLGO↔IORM FLGZ
04100
04200 ;HARD OUTSIDER CASES.
04300 SKIPGE FLGO↔GO @XYCLIP
04400 SKIPL FLGZ↔GO @XYCLIP
00100 ;XY-CLIPPER continued.
00200 ;NORTH BORDER CROSSING.
00300 LAC QNE↔XOR QNW↔SKIPL↔GO L2
00400 LAC Y1↔CAMGE Y2↔LAC Y2↔CAMG YH↔GO L2
00500 LAC BYH↔FADR C↔MOVNS↔FDVR A↔FIXX↔DIP(PTR)
00600 LAC YH↔FIXX↔DAP(PTR)
00700 AOBJN PTR,.+2↔GO L
00800
00900 ;SOUTH BORDER CROSSING.
01000 L2: LAC QSE↔XOR QSW↔SKIPL↔GO L3
01100 LAC Y1↔CAMLE Y2↔LAC Y2↔CAML YL↔GO L3
01200 LAC BYL↔FADR C↔MOVNS↔FDVR A↔FIXX↔DIP(PTR)
01300 LAC YL↔FIXX↔DAP(PTR)
01400 AOBJN PTR,.+2↔GO L
01500
01600 ;EAST BORDER CROSSING.
01700 L3: LAC QSE↔XOR QNE↔SKIPL↔GO L4
01800 LAC X1↔CAMGE X2↔LAC X2↔CAMG XH↔GO L4
01900 LAC XH↔FIXX↔DIP(PTR)
02000 LAC AXH↔FADR C↔MOVNS↔FDVR B↔FIXX↔DAP(PTR)
02100 AOBJN PTR,.+2↔GO L
02200
02300 ;WEST BORDER CROSSING.
02400 L4: LAC QSW↔XOR QNW↔SKIPL↔GO L5
02500 LAC X1↔CAMLE X2↔LAC X2↔CAML XL↔GO L5
02600 LAC XL↔FIXX↔DIP(PTR)
02700 LAC AXL↔FADR C↔MOVNS↔FDVR B↔FIXX↔DAP(PTR)
02800 AOBJN PTR,.+2↔GO L
02900
03000 ;STRANGE EXIT - VMARK & ECOEF ARE INCONSISTENT.
03100 L5: OUTSTR[ASCIZ/XY-CLIPPER FALL THRU !
03200 /]↔ GO @XYCLIP
03300
03400 ;VISIBLE PORTION EXIT.
03500 L: AOS XYCLIP
03600 GO @XYCLIP
03700 LIT
03800 BEND;1/14/73------------------------------------------------------
03900 ;END OF XY-CLIPPER.
00100 SUBR(CLIPER)WINDOW -----------------------------------------------
00200 BEGIN CLIPER
00300 ACCUMULATORS{E,V1,V2,X1,Y1,X2,Y2,PTR,B,LINK}
00400 JSR VMARK
00500 SETZM CNT#↔SETZ LINK,;NIL OF THE LIST.
00600
00700 ;FOR ALL THE BODIES OF THE WORLD.
00800 LAC B,ARG1↔ALT2 B,B
00900 L1: CCW B,B
01000 TEST B,BBIT↔GO[PED. LINK,B↔POP1J] ;EXIT.
01100
01200 ;FOR ALL THE EDGES OF EACH BODY.
01300 LAC E,B
01400 L2: PED E,E
01500 TEST E,EBIT↔GO L1
01600 TESTZ E,DARKEN↔GO L2
01700 TEST E,VISIBLE∨POTENT↔GO L2
01800
01900 ;DOES EDGE NEED Z-CLIPPING.
02000 PVT V1,E↔NVT V2,E↔LACI PTR,U
02100 LDB 1,[POINT 2,(E),10] ;PICKUP PZZ/NZZ.
02200 SLACI(PZZ∨NZZ)↔ANDCAM(E) ;CLEAR 'EM.
02300 GO .+1(1) ;PZZ,NZZ
02400 JFCL ;0,0 - EDGE AIN'T MARKED.
02500 GO L3 ;0,1 - INVIEW HALFSPACE.
02600 GO L4 ;1,0 - OUT'A'SIGHT.
02700 TEST V2,NZZ ;1,1 - NEEDS Z-CLIPPING.
02800 EXCH V1,V2 ;GET V2 INVIEW.
02900
03000 ;CALL SUB-CLIPPER-ROUTINES.
03100 SETQ(V1,{ZCLIP,V1,PTR,V2})
03200 L3: SLACI PTR,-2↔LAPI PTR,-3(E)
03300 JSR XYCLIP
03400 GO [L4: MARKZ E,VISIBLE↔GO L2]
03500
03600 ;CONS EDGE INTO VISIBLE EDGE LIST.
03700 AOS CNT#
03800 MARK E,VISIBLE
03900 ALT2. LINK,E
04000 LAC LINK,E
04100 GO L2
04200
04300 ;PSEUDO VERTEX FOR Z-CLIPPER.
04400 LIT↔VAR
04500 0↔0↔0↔U: BLOCK 9
04600 BEND;2/5/73-------------------------------------------------------
00100 ;MAKE CURVY EDGED OBJECTS.
00200 SUBR(MKCURV)------------------------------------------------------
00300 BEGIN MKCURV
00400 EXTERN ESPLIT,NORM
00500 ACCUMULATORS{V,V1,V2,E}
00600 BDY←15
00700
00800 ;PUT NORMAL VECTORS ON EVERYTHING.
00900 DAC 12,TMP12#
01000 ; LAC BDY,WORLD
01100 ;L1: CCW BDY,BDY
01200 ; TEST BDY,BBIT↔GO L2
01300 LAC BDY,ARG1
01400 SETZ↔CALL(FACOEF,BDY,0) ;WORLD COORDINATES FACE COEF.
01500 CALL(ENORM,BDY)
01600 CALL(VNORM,BDY)
01700 ; GO L1
01800
01900 L2: CCW BDY,BDY
02000 ; TESTZ BDY,BBIT↔GO .+3↔LAC 12,TMP12↔POP0J
02100 LAC E,ARG1
02200 L3: PED E,E↔TEST E,EBIT↔GO L2
02300 MOVSI AA(E)↔HRRI J↔BLT J+2 ;EDGE NORMAL AS Y-AXIS.
02400 PVT V1,E↔NVT V2,E
02500 TESTZ V1,TMPBIT↔GO L2
02600 TESTZ V2,TMPBIT↔GO L2
02700
02800 ;EDGE FRAME ORIGIN IS THE EDGE'S MIDPOINT.
02900 LAC XWC(V1)↔FAD XWC(V2)↔FSC -1↔DAC L+0 ;ORIGIN AT EDGE MIDPOINT.
03000 LAC YWC(V1)↔FAD YWC(V2)↔FSC -1↔DAC L+1
03100 LAC ZWC(V1)↔FAD ZWC(V2)↔FSC -1↔DAC L+2
03200 ;EDGE LINE IS THE X-AXIS.
03300 LAC XWC(V1)↔FSB XWC(V2)↔DAC I+0
03400 LAC YWC(V1)↔FSB YWC(V2)↔DAC I+1
03500 LAC ZWC(V1)↔FSB ZWC(V2)↔DAC I+2
03600
03700 ;HALF EDGE LENGTH IS UNIT.
03800 LAC 0,I+0↔FMP
03900 LAC 1,I+1↔FMP 1,I+1↔FAD 1
04000 LAC 1,I+2↔FMP 1,I+2↔FAD 1
04100 CALL(SQRT,0)↔LAC 1 ;EDGE'S LENGTH.
04200 FSC 1,-1↔DAC 1,S ;SCALE UNIT.
04300 FDVR [0.30]↔FIXX↔DAC CNT# ;NUMBER OF SPACES.
04400 FSC 233↔MOVSI 1,(1.0)↔DAC 1,X# ;INITIAL X=+1.
04500 FDVR 1,0↔FSC 1,1↔DACN 1,DX#↔SOS CNT
00100 ;CROSS I-VECTOR INTO J-VECTOR TO GET K-VECTOR RIGHT-HANDED.
00200 K1: LAC 0,I+1↔FMPR 0,J+2
00300 LAC 1,J+1↔FMPR 1,I+2↔FSBR 0,1↔DAC 0,K+0
00400 LAC 0,J+0↔FMPR 0,I+2
00500 LAC 1,I+0↔FMPR 1,J+2↔FSBR 0,1↔DAC 0,K+1
00600 LAC 0,I+0↔FMPR 0,J+1
00700 LAC 1,J+0↔FMPR 1,I+1↔FSBR 0,1↔DAC 0,K+2
00800 MOVEI I↔CALL(NORM,0)
00900
01000 ;COMPUTE SLOPE M EDGE'S PVT.
01100 K2: PVT V,E
01200 LAC [XWD I,7]↔BLT 14 ;PICKUP I&J VECTORS.
01300 FMP 7,XPP(V)↔FMP 12,XPP(V) ;DOT WITH VERTEX NORMAL.
01400 FMP 10,YPP(V)↔FMP 13,YPP(V)
01500 FMP 11,ZPP(V)↔FMP 14,ZPP(V)
01600 FAD 7,10↔FAD 7,11↔FAD 12,13↔FAD 12,14
01700 FDVR 7,12↔DACN 7,M# ;SLOPE DY/DX AT PVT.
01800
01900 ;COMPUTE SLOPE N EDGE'S NVT.
02000 K3: NVT V,E
02100 LAC [XWD I,7]↔BLT 14 ;PICKUP I&J VECTORS.
02200 FMP 7,XPP(V)↔FMP 12,XPP(V) ;DOT WITH VERTEX NORMAL.
02300 FMP 10,YPP(V)↔FMP 13,YPP(V)
02400 FMP 11,ZPP(V)↔FMP 14,ZPP(V)
02500 FAD 7,10↔FAD 7,11↔FAD 12,13↔FAD 12,14
02600 FDVR 7,12↔DACN 7,N# ;SLOPE DY/DX AT NVT.
02700
02800 ;SETUP CUBIC COEFFICIENTS.
02900 K4: LAC M↔FAD N↔FSC -2
03000 DAC A#↔DACN C#
03100 LAC M↔FSB N↔FSC -2
03200 DAC B#↔DACN D#
00100 ;CREATE A VERTEX ON THE CUBIC EDGE.
00200 L4: LAC X↔FAD DX↔DAC X
00300 SETQ(V,{ESPLIT,E})
00400 MARK V,TMPBIT
00500 ;LOCUS IN Y = ((A*X+B)*X+C)*X+D).
00600 LAC A↔FMP X↔FAD B↔FMP X↔FAD C↔FMP X↔FAD D
00700 FMP S↔DAC 7↔DAC 8↔DAC 9
00800 ;EDGE FRAME TO WORLD FRAME.
00900 FMP 7,J↔FMP 8,J+1↔FMP 9,J+2
01000 LAC 1,X↔FMP 1,S
01100 LAC I+0↔FMP 1↔FAD 7,
01200 LAC I+1↔FMP 1↔FAD 8,
01300 LAC I+2↔FMP 1↔FAD 9,
01400 FAD 7,L+0↔FAD 8,L+1↔FAD 9,L+2 ;TRANSLATE.
01500 DAC 7,XWC(V)↔DAC 8,YWC(V)↔DAC 9,ZWC(V)
01600 SOSLE CNT↔GO L4↔GO L3
01700
01800 ;EDGE FRAME OF REFERENCE.
01900 L: 0 ↔ 0 ↔ 0 ;ORIGIN.
02000 I: 0 ↔ 0 ↔ 0
02100 J: 0 ↔ 0 ↔ 0
02200 K: 0 ↔ 0 ↔ 0
02300 S: 0 ;SCALE.
02400 ;L2: LAC 12,TMP12↔POP1J
02500 BEND;1/14/73------------------------------------------------------
00100 END
00200 VIEWER.FAI - EOF.